perm filename OUR.COR[UCI,SYS] blob sn#073819 filedate 1973-11-22 generic text, type T, neo UTF8
-!ILISP.MAC←UCILSP.MAC
-2,2
TITLE ILISP INTERPRETER
-6,7
-26,26
DEFINE SYSNAM <SIXBIT /ILISP2/>				;	*** MJC
-178,186
;	CAME	0,STNIL	;$$UNBIND STACK IF REGS LOOK OK		*** MJC
;	JRST	GETHGH	;GO GET HIGH SEGMENT			*** MJC
;	MOVE	B,SC2						*** MJC
;	PUSHJ	P,UBD	;$$UNBIND STACK				*** MJC
;	JRST STRT	;go to re-allocator			*** MJC
;GETHGH:	CALLI	RESET					*** MJC
;	MOVSI	A,1						*** MJC
;IFE STANSW,<	CALLI	A,CORE	;ELIMINATE ANY OLD HIGH SEGS.	*** MJC
;	HALT >							*** MJC
-192,200
       	MOVE	A,HGHDAT+1	; Get high segment name		*** MJC
	CALLI	A,400016	; Attach to high seg if poss.	*** MJC
	CAIN	A,4	; If err=4 (seg alrdy there) ok too	*** MJC
	JRST	SGPROT		; Success!			*** MJC

	CALLI	400017		; Detach stray segments.	*** MJC
	MOVE	A,HGHDAT	; Get device name for OPEN.	*** MJC
	MOVEM	A,INTDAT+1	; Move into parm list for OPEN.	*** MJC
	OPEN	0,INTDAT  	; Init ch 0 to dump mode.	*** MJC
	JRST	NOSEG		; Couldn't do it?		*** MJC
	MOVE	A,SGPPPN	; Get ppn of high seg file.	*** MJC
	MOVEM	A,HGHDAT+4	; Store for LOOKUP.		*** MJC
	LOOKUP	0,HGHDAT+1	; Find file containing high seg	*** MJC
	JRST	NOSEG		; No high seg file -- collapse	*** MJC
	HLRE	A,HGHDAT+4	; Ppn was replaced by -length	*** MJC
	MOVNS	A		; Fix up for CORE2.		*** MJC
	CALLI	A,400015	; Grab core for high segment.	*** MJC
	JRST	NOSEG		; Can't get it?			*** MJC
	MOVE	A,HGHDAT+1	; Name the high segment.	*** MJC
	CALLI	A,400036	; SEGNM2 uuo.			*** MJC
	JRST	NOSEG		; Pretty weird.			*** MJC
	MOVEI	A,SHRST-1	; For dump mode input.		*** MJC
	HRRM	A,HGHDAT+4	;				*** MJC
	INPUT	0,HGHDAT+4	; Fill high seg with goodies.	*** MJC
	CLOSE	0,1		; Destroy fingerprints.		*** MJC
SGPROT:	MOVEI	A,DEBUGO	;SET THE REE ADDRESS
	HRRM	A,JOBREN
	MOVE	A,HGHDAT+1	; Decide whether or not to 	*** MJC
	CAME	A,[SYSNAM]	;   protect segment.		*** MJC
	JRST	STRT		; Segment was not system's	*** MJC
	CALLI	36		; Write-protect segment.	*** MJC
	HALT			; rather than turn him loose.	*** MJC
	JRST	STRT		;GO TO ALLOCATE STORAGE
NOSEG:	OUTSTR	[ASCIZ/CAN'T GET HIGH SEGMENT!/] ;		*** MJC
	HALT					;		*** MJC
HGHDAT:	SYSDEV			; All used by LOOKUP and ENTER	*** MJC
	SYSNAM			; High segment job & file name	*** MJC
	0			; High seg file extension.	*** MJC
	0	
	0			; PRG,PPN of high seg file.	*** MJC
				; Also file length after LOOKUP	*** MJC
				; Used as dump wd cmd list.	*** MJC
	0
INTDAT:	17			; Data mode.			*** MJC
	SYSDEV			; Dev name (defd before OPEN)	*** MJC
	0			; Buffer indicators (none)	*** MJC
SGPPPN:	XWD	SYSPRG,SYSPN	; High seg file area		*** MJC
PATCHL:	BLOCK	20
 >
-201:
-5049,5049
NAME:	SIXBIT/ILISP/
-5158,5163
	CAME	A,[SYSNAM]	;				*** MJC
; We're not allowing him to name his segment the same as ours,	*** MJC
;   since that causes problems for ATTSEG, so test for it.	*** MJC
	JRST	GUDSEG	;					*** MJC
	MOVE	B,[SYSDEV]	; But if he's a system hacker	*** MJC
	CAME	B,DEV		;   then we let him get away	*** MJC
	JRST	BADSEG		;   with it.			*** MJC
GUDSEG:	MOVEM	A,HGHDAT+1	;SAVE THE FILE NAME
	MOVE	A,DEV		;GET THE DEVICE AND SAVE IT
	MOVEM	A,HGHDAT
	MOVEM	A,INTDAT+1	; Save it for OPEN, too.	*** MJC
	MOVE	A,PPN		;GET THE PPN AND SAVE IT
	MOVEM	A,SGPPPN	;				*** MJC
	MOVEM	A,HGHDAT+4
	SKIPN	A,EXT		; Get extension and save it.	*** MJC
	MOVE	A,[SIXBIT/SEG/]	; No ext -- use SEG instead.	*** MJC
	MOVEM	A,HGHDAT+2	; Move ext into OPEN stuff.	*** MJC
	OPEN	0,INTDAT  	; Open for dump output.		*** MJC
	JRST	BADSEG		; Couldn't open?		*** MJC
	ENTER	0,HGHDAT+1	; Hookup to file.		*** MJC
	JRST	BADSEG		; Couldn't do it?		*** MJC
	CALLI	A,400022	; Find size of high segment.	*** MJC
	MOVNS	A		; Construct dump mode cmd wd.	*** MJC
	HRLM	A,HGHDAT+4	; I.e. -length to left half	*** MJC
	MOVEI	A,SHRST-1	;   and <start>-1 to rt half.	*** MJC
	HRRM	A,HGHDAT+4	;				*** MJC
	OUTPUT	0,HGHDAT+4	;				*** MJC
	CLOSE	0,2		; Leave no traces		*** MJC
	JRST	FALSE		;RETURN NIL
BADSEG:	ERR1	[SIXBIT/ILLEGAL NAME FOR SEGMENT!/] ;		*** MJC
	JRST	FALSE	;					*** MJC